home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / win / pasock10.zip / FINGERD.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-16  |  8KB  |  253 lines
  1. {
  2.   Public Domain  - Please leave this notice intact.
  3.   Mike Caughran Cedar Island Software OCT 1994
  4.   All the usual disclaimers apply.
  5.   Implement a finger daemon using Borland Pascal 7
  6.  
  7.   71034.2371@compuserve.com
  8.   907-789-9030 voice
  9.   907-789-1694 bbs
  10. }
  11.  
  12. {
  13.   Fingerd is one of the easiest servers to implement and
  14.   demonstrates how to use sockets clearly.
  15.   WinCRT is used also for clarity.  (Eschew Obfuscation.)
  16.   Finger usually resides on socket 79.
  17.  
  18.   Usage: Install a TCP/IP stack with associated WINSOCK.DLL.
  19.          If you have no TCP/IP stack, then get TRUMPET.
  20.          Start fingerd.exe from Windows and leave running.
  21.          Telnet to the host running fingerd.  (use port 79
  22.            instead of the standard telnet port 23)
  23.          Press enter on the telnet client and you should
  24.          see the finger information sent back to you.
  25.  
  26.          Or you can use the finger client supplied to connect
  27.          with the finger daemon.
  28.  
  29. }
  30.  
  31.  
  32. program fingerd;
  33.  
  34. uses winsock, strings, wincrt, winprocs, wintypes;
  35.  
  36. var
  37.   myVerReqd : word;
  38.   myWSAData : WSADATA;
  39.   s : String[255];
  40.   i : integer;
  41.   CharArray: array[0..255] of char;
  42.   HostNameArray: array[0..255] of char;
  43.   FingerSocket, AcceptSocket : tSOCKET;
  44.   err : integer;
  45.   FingerPort : word;
  46.   Remote_Addr: sockaddr_in;
  47.   Remote_Host: Phostent;
  48.  
  49. procedure CleanUp; Forward;
  50.  
  51. {$I ERROR.INC}
  52.  
  53. {----------------------------------------}
  54. { -- Start of code to SubClass WinCRT -- }
  55. {----------------------------------------}
  56. var
  57.   OldWndProc : TFarProc;
  58. const
  59.   hCRTWnd : HWND        = 0;
  60.   cm_Exit               = 100;
  61.   cm_About              = 101;
  62.   USER_CONNECT         = WM_USER + 100;
  63.   USER_READ            = WM_USER + 101;
  64.  
  65. var
  66.   ThisLen : integer;
  67.   ThisAddr : sockaddr;
  68.   Buff : array [0..1024] of char;
  69.   ReadCount,Readindex : Integer;
  70.  
  71.  
  72. function WindowProc(Window:HWnd; Message,wParam:Word; lParam:LongInt) : LongInt; export;
  73. begin
  74.   case Message of
  75.     wm_Char        : begin
  76.                        if wParam=vk_Escape then begin
  77.                          CleanUp;
  78.                          DoneWinCRT;
  79.                        end;
  80.                      end;
  81.     wm_Command     : begin
  82.       case WParam of
  83.     cm_About:   MessageBox(Window,
  84. 'Finger Daemon'#13'Public Domain 1994 by'#13'Mike Caughran'#13'Cedar Island Software',
  85.                     'Pascal Finger Daemon',mb_IconQuestion);
  86.     cm_Exit:    begin
  87.                       CleanUp;
  88.                       DoneWinCrt;
  89.                     end;
  90.       end;
  91.     end;
  92.     USER_CONNECT : begin
  93.                      writeln('Received a USER_CONNECT message');
  94.                      if (WSAGetSelectError(lparam) <> 0) then Error('USER_CONNECT msg')
  95.                      else begin
  96.                        ThisLen := SizeOf(Remote_Addr);
  97.                        ThisAddr := SockAddr(Remote_Addr);
  98.                        AcceptSocket := accept(FingerSocket, @ThisAddr, @ThisLen);
  99.  
  100.                        writeln('AcceptSocket=',acceptSocket);
  101.                        if AcceptSocket=INVALID_SOCKET  then Error('AcceptSocket')
  102.                        else WSAAsyncSelect(AcceptSocket, hCRTWnd, USER_READ, FD_READ);
  103.                      end;
  104.                    end;
  105.     USER_READ :    begin
  106.                       writeln('Received a USER_READ message');
  107.                       ReadCount := recv(AcceptSocket, Buff, 1024, 0);
  108.                       if ReadCount = SOCKET_ERROR then Error('Read')
  109.                       else begin
  110.                         writeln('Characters received:');
  111.                         for ReadIndex := 0 to ReadCount do Write(Buff[ReadIndex]);
  112.                         strCopy(Buff,'Hello from fingerd world'#0);
  113.                         if (Send(AcceptSocket,Buff,strlen(Buff),0) < strlen(Buff))
  114.                           then error('Send');
  115.                       end;
  116.                       closesocket(AcceptSocket);
  117.                     end;
  118.   end;
  119.   WindowProc := CallWindowProc(OldWndProc, Window, Message, wParam, lParam);
  120. end;
  121.  
  122. procedure MakeMenu;
  123. var
  124.   Menu      : HMenu;
  125.   FileMenu  : HMenu;
  126. begin
  127.   Menu := CreateMenu;
  128.   FileMenu := CreateMenu;
  129.   AppendMenu(Menu, mf_PopUp or mf_Enabled, FileMenu, 'File');
  130.   AppendMenu(FileMenu, mf_Enabled, cm_Exit, 'Exit');
  131.   AppendMenu(Menu, mf_Enabled, cm_About, 'About');
  132.   SetMenu(hCRTWnd,Menu);
  133. end;
  134.  
  135. procedure myInitWinCRT;
  136. var
  137.   hInstance : THandle;
  138.   WindowClass : TWndClass;
  139. begin
  140.   GetClassInfo(hInstance, 'TPWinCrt' ,WindowClass);
  141.   UnregisterClass('TPWinCRT', hInstance);
  142.   WindowClass.hIcon := LoadIcon(0, idi_Question);
  143.   WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  144.   OldWndProc := tFarProc(WindowClass.lpfnWndProc);
  145.   WindowClass.lpfnWndProc := @WindowProc;
  146.   RegisterClass(WindowClass);
  147.   InactiveTitle := '%s';
  148.   StrCopy(WindowTitle,'Pascal Finger Daemon V1.0');
  149.   InitWinCrt;
  150.   hCRTWnd := GetActiveWindow;
  151.   MakeMenu;
  152. end;
  153.  
  154. {--------------------------------------}
  155. { -- End of code to SubClass WinCRT -- }
  156. {--------------------------------------}
  157.  
  158.  
  159.  
  160. procedure StartUp;
  161. begin
  162.   myVerReqd:=$0101;
  163.   Writeln('Winsock version required : ',hibyte(myVerReqd),'.',lobyte(myVerReqd));
  164.   if WSAStartup(myVerReqd,@myWSAData) <>0 then Abort('WSAStartup');
  165. end;
  166.  
  167. procedure ShowWinSockInfo;
  168. begin
  169.   Write('Winsock Version found: ');
  170.   Writeln(lobyte(myWSAData.wVersion),'.',lobyte(myWSAData.wHighVersion));
  171.   S := StrPas(myWSAData.szDescription);
  172.   Writeln('Description=',S);
  173.   S := StrPas(myWSAData.szSystemStatus);
  174.   Writeln('SystemStatus=',S);
  175.   Writeln('MaxSockets=',word(myWSAData.iMaxSockets));
  176.   Writeln('MaxUdpDg=',word(myWSAData.iMaxUdpDg));
  177.   Write('VendorInfo= ');
  178.     if myWSAData.lpVendorInfo <> NIL then begin
  179.       writeln(myWSAData.lpVendorInfo);
  180.     end else writeln('NULL');
  181.   Write('Local Hostname=');
  182.   if (gethostname(@CharArray,255) <> 0) then Error('GetHostName')
  183.     else writeln(CharArray);
  184. end;
  185.  
  186. procedure FindFingerService;
  187. var
  188.   pSE : pServEnt;
  189. begin
  190.   FingerPort := 0;
  191.   pSE := getservbyname('finger','tcp');
  192.   if pSE = nil then begin
  193.     Error('GetServByName'); Writeln;
  194.     Writeln('Finger is usually on port 79.  Check Services table.');
  195.   end
  196.   else begin
  197.     FingerPort := htons(pSE^.s_port);
  198.     Writeln('Using finger service on port ',FingerPort);
  199.   end;
  200. end;
  201.  
  202. procedure CreateSocket;
  203. begin
  204.   FingerSocket:=socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  205.   If FingerSocket = INVALID_SOCKET then Abort('Can''t CreateSocket')
  206.   else
  207.     Writeln('Socket descriptor allocated : ',ord(FingerSocket));
  208. end;
  209.  
  210. procedure BindToSocket;
  211. begin
  212.   Remote_addr.sin_family := PF_INET;
  213.   Remote_addr.sin_port := htons(FingerPort);
  214.   Remote_addr.sin_addr.s_addr:=INADDR_ANY;
  215.   if bind(FingerSocket, sockaddr(Remote_Addr), SizeOf(Remote_Addr)) <> 0 then
  216.   begin
  217.     CloseSocket(FingerSocket);
  218.     Abort('Bind');
  219.   end;
  220. end;
  221.  
  222. procedure ListenToSocket;
  223. var
  224.   rc : integer;
  225. begin
  226.   rc := listen(FingerSocket,5);
  227.   if rc > 0 then Error('Listen');
  228.   rc := rc + WSAAsyncSelect(FingerSocket, hCRTWnd, USER_CONNECT, FD_ACCEPT);
  229.   if rc > 0 then begin
  230.     CloseSocket(FingerSocket);
  231.     Abort('WSAAsyncSelect');
  232.   end;
  233. end;
  234.  
  235. procedure CleanUp;
  236. begin
  237.   if WSACleanup <> 0 then Error('WSACleanup');
  238. end;
  239.  
  240. procedure DoFingerd;
  241. begin
  242.   StartUp;
  243.   ShowWinsockInfo;
  244.   FindFingerService;
  245.   CreateSocket;
  246.   BindToSocket;
  247.   ListenToSocket;
  248. end;
  249.  
  250. begin
  251.   MyInitWinCRT;
  252.   DoFingerd;
  253. end.